{********************************************************}
{                                                        }
{                 Zeos Database Objects                  }
{             Abstract Transaction component             }
{                                                        }
{       Copyright (c) 1999-2001 Sergey Seroukhov         }
{    Copyright (c) 1999-2002 Zeos Development Group      }
{                                                        }
{********************************************************}

unit ZTransact;

interface

{$R *.dcr}

uses
  {$IFNDEF LINUX} ExtCtrls, {$ELSE}
  {$IFNDEF NO_GUI} QExtCtrls, {$ELSE}ZLTimer,{$ENDIF}
  {$ENDIF}
  SysUtils, DB, Classes, ZToken, ZConnect, ZDirSql, ZSqlTypes, ZSqlScanner;

{$IFNDEF LINUX}
{$INCLUDE ..\Zeos.inc}
{$ELSE}
{$INCLUDE ../Zeos.inc}
{$ENDIF}



type
  { Transact options }
  TZZTransactOption = (toHourGlass);
  TZZTransactOptions = set of TZZTransactOption;
  TZZMonitor = class;

  { BatchExecSql event handlers }
  TOnBeforeBatchExec = procedure (Sender: TObject; var Sql: string) of object;
  TOnAfterbatchExec = procedure (Sender: TObject; var Res: Integer) of object;
  TOnBatchError = procedure (Sender: TObject; const E: Exception; var Stop: Boolean) of object;

  { Abstract transaction component }
  TZZTransact = class(TComponent)
  protected
    FConnected: Boolean;
    FAutoCommit: Boolean;
    FAutoRecovery: Boolean;
    FNotifies: TList;
    FOptions: TZZTransactOptions;
    FDatabase: TZZDatabase;
    FDatabaseType: TDatabaseType;
    FHandle: TDirTransact;
    FQuery: TDirQuery;
    FOnDataChange: TNotifyEvent;
    FOnApplyUpdates: TNotifyEvent;
    FOnCommit: TNotifyEvent;
    FOnRollback: TNotifyEvent;
    FOnBeforeConnect: TNotifyEvent;
    FOnAfterConnect: TNotifyEvent;
    FOnBeforeDisconnect: TNotifyEvent;
    FOnAfterDisconnect: TNotifyEvent;
    FVersion: Integer;
    FBatchCurPos, FBatchCurLen, FBatchCurrentLine: Integer;
    FOnBeforeBatchExec: TOnBeforeBatchExec;
    FOnAfterBatchExec: TOnAfterBatchExec;
    FOnBatchError: TOnBatchError;

    procedure SetConnected(Value: Boolean);
    procedure SetDatabase(Value: TZZDatabase);
    function  GetTransactSafe: Boolean;
    procedure SetTransactSafe(Value: Boolean);
    function  GetNotifies(Index: Integer): TObject;
    function  GetNotifyCount: Integer;

    procedure Loaded; override;

    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure DoDataChange(Sql: string);
    procedure DoCommit;
    procedure DoRollback;

    property AutoRecovery: Boolean read FAutoRecovery write FAutoRecovery;
    property DatabaseType: TDatabaseType read FDatabaseType;
    property TransactSafe: Boolean read GetTransactSafe write SetTransactSafe;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Connect; virtual;
    procedure Disconnect; virtual;
    function ExecSql(Sql: WideString; comp : TComponent): LongInt; virtual;
    function ExecSqlParams(Sql: WideString; Params: TVarRecArray;
      ParamCount: Integer): LongInt; virtual;
    function BatchExecSql(Sql: WideString): LongInt;
    function ExecFunc(Func: WideString): WideString; virtual;
    procedure Commit; virtual;
    procedure Rollback; virtual;
    procedure Recovery(Force: Boolean); virtual;
    procedure DoApplyUpdates;
    procedure StartTransaction;

    procedure AddMonitor(Monitor: TZZMonitor); virtual; abstract;
    procedure DeleteMonitor(Monitor: TZZMonitor); virtual; abstract;

    procedure AddNotify(Notify: TObject);
    procedure RemoveNotify(Notify: TObject);
    procedure CloseNotifies;

    property Database: TZZDatabase read FDatabase write SetDatabase;
    property Connected: Boolean read FConnected write SetConnected;
    property Handle: TDirTransact read FHandle;
    property QueryHandle: TDirQuery read FQuery;

    property Notifies[Index: Integer]: TObject read GetNotifies;
    property NotifyCount: Integer read GetNotifyCount;
  published
    property Options: TZZTransactOptions read FOptions write FOptions;
    property AutoCommit: Boolean read FAutoCommit write FAutoCommit;
    property Version: Integer read FVersion;
    property BatchCurPos: Integer read FBatchCurPos;
    property BatchCurLen: Integer read FBatchCurLen;
    property BatchCurrentLine: Integer read FBatchCurrentLine;

    property OnBeforeConnect: TNotifyEvent read FOnBeforeConnect write FOnBeforeConnect;
    property OnAfterConnect: TNotifyEvent read FOnAfterConnect write FOnAfterConnect;
    property OnBeforeDisconnect: TNotifyEvent read FOnBeforeDisconnect write FOnBeforeDisconnect;
    property OnAfterDisconnect: TNotifyEvent read FOnAfterDisconnect write FOnAfterDisconnect;
    property OnBeforeBatchExec: TOnBeforeBatchExec read FOnBeforeBatchExec write FOnBeforeBatchExec;
    property OnAfterBatchExec: TOnAfterBatchExec read FOnAfterBatchExec write FOnAfterBatchExec;
    property OnBatchError: TOnBatchError read FOnBatchError write FOnBatchError;
    property OnDataChange: TNotifyEvent read FOnDataChange write FOnDataChange;
    property OnApplyUpdates: TNotifyEvent read FOnApplyUpdates write FOnApplyUpdates;
    property OnCommit: TNotifyEvent read FOnCommit write FOnCommit;
    property OnRollback: TNotifyEvent read FOnRollback write FOnRollback;
  end;

  { Event on post sql query }
  TMonitorEvent = procedure(Sql, Result: string) of object;

  { Abstract component for monitoring outgoing queries }
  TZZMonitor = class (TComponent)
  private
    FTransact: TZZTransact;
    FMonitorEvent: TMonitorEvent;
    procedure SetTransact(const Value: TZZTransact);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    destructor Destroy; override;
  published
    property Transaction: TZZTransact read FTransact write SetTransact;
    property OnMonitorEvent: TMonitorEvent read FMonitorEvent write FMonitorEvent;
  end;

  { Monitors list class }
  TZZMonitorList = class (TList)
  private
    function GetMonitor(Index: Integer): TZZMonitor;
  public
    procedure AddMonitor(Value: TZZMonitor);
    procedure DeleteMonitor(Value: TZZMonitor);
    procedure InvokeEvent(Sql, Result: WideString; Error: Boolean);

    property Monitors[Index: Integer]: TZZMonitor read GetMonitor;
  end;

  { Sql statements executing component }
  TZZBatchSql = class(TComponent)
  private
    FTransact: TZZTransact;
    FAffectedRows: LongInt;
    FBeforeExecute: TNotifyEvent;
    FAfterExecute: TNotifyEvent;
    FSql: TStringList;

    procedure SetSql(Value: TStringList);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

    procedure ExecSql;
  published
    property Transaction: TZZTransact read FTransact write FTransact;
    property Sql: TStringList read FSql write SetSql;
    property RowsAffected: LongInt read FAffectedRows;

    property OnBeforeExecute: TNotifyEvent read FBeforeExecute write FBeforeExecute;
    property OnAfterExecute: TNotifyEvent read FAfterExecute write FAfterExecute;
  end;

  { Custom Notify event handler type }
  TZZNotifyEvent = procedure (Sender: TObject; Event: string) of object;

  { Asynchronous notifying}
  TZZNotify = class (TComponent)
  private
    FActive: Boolean;
    FAutoOpen: Boolean;
    FEventsList: TStringList;
    FTimer: TTimer;
    FFirstConnect: Boolean;

    FBeforeRegister: TZZNotifyEvent;
    FBeforeUnregister: TZZNotifyEvent;
    FAfterRegister: TZZNotifyEvent;
    FAfterUnregister: TZZNotifyEvent;
    FNotifyFired: TZZNotifyEvent;
  protected
    FTransact: TZZTransact;
    FHandle: TDirNotify;
    FBackEventsList: TStringList;

    procedure SetActive(Value: Boolean);
    function GetInterval: Cardinal; virtual;
    procedure SetInterval(Value: Cardinal); virtual;
    procedure SetEventsList(Value: TStringList); virtual;
    procedure SetTransact(Value: TZZTransact);

    procedure TimerProc(Sender: TObject); virtual;
    procedure CheckEvents; virtual;
    procedure EventsChange(Sender: TObject); virtual;
    procedure EventsChanging(Sender: TObject); virtual;
    procedure CheckActive; virtual;

  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Open; virtual;
    procedure Close; virtual;

    procedure ListenTo(Event: string);
    procedure DoNotify(Event: string);
    procedure UnlistenTo(Event: string);

    property Handle: TDirNotify read FHandle;
  published

    property Active: Boolean read FActive write SetActive;
    property EventsList: TStringList read FEventsList write SetEventsList;
    property Interval: Cardinal read GetInterval write SetInterval;

    property OnBeforeRegister: TZZNotifyEvent read FBeforeRegister write FBeforeRegister;
    property OnAfterRegister: TZZNotifyEvent read FAfterRegister write FAfterRegister;
    property OnBeforeUnregister: TZZNotifyEvent read FBeforeUnregister write FBeforeUnregister;
    property OnAfterUnregister: TZZNotifyEvent read FAfterUnregister write FAfterUnregister;
    property OnNotify: TZZNotifyEvent read FNotifyFired write FNotifyFired;
  end;

  { Custom TThread descendent to allow true asynchronous notify processing }
implementation

uses ZDbaseConst, ZConvert, ZSqlScript
{$IFNDEF NO_GUI}{$IFNDEF LINUX}
  ,Windows, Controls, Forms
{$ELSE}
  ,QControls, QForms
{$ENDIF}{$ENDIF};

{***************** TZZTransact implementation *****************}

{ Class constructor }
constructor TZZTransact.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FConnected  := False;
  FAutoCommit := True;
  FOptions := [toHourGlass];
  FVersion := ZDBO_VERSION;
  FNotifies := TList.Create;
  FDatabaseType := dtUnknown;
end;

{ Class destructor }
destructor TZZTransact.Destroy;
begin
  if Connected then
    Disconnect;
  CloseNotifies;
  
  if Assigned(FDatabase) then
    FDatabase.RemoveTransaction(Self);
  FQuery.Free;
  FHandle.Free;
  FNotifies.Free;
  inherited Destroy;
end;

{ Set connected prop }
procedure TZZTransact.SetConnected(Value: Boolean);
begin
  if Value <> FConnected then
    if Value then Connect
    else Disconnect;
end;

{ Set database connection prop }
procedure TZZTransact.SetDatabase(Value: TZZDatabase);
begin
  Disconnect;
  try
    if Assigned(FDatabase) then
      FDatabase.RemoveTransaction(Self);
    if Assigned(Value) then
      Value.AddTransaction(Self);
  finally
    FDatabase := Value;
    if Assigned(FDatabase) then
    begin
      FHandle.Connect := FDatabase.Handle;
      FQuery.Connect := FDatabase.Handle;
    end
    else
    begin
      FHandle.Connect := nil;
      FQuery.Connect := nil;
    end;
  end;
end;

{ Get transaction safe property }
function TZZTransact.GetTransactSafe: Boolean;
begin
  Result := Handle.TransactSafe;
end;

{ Set transaction safe property}
procedure TZZTransact.SetTransactSafe(Value: Boolean);
begin
  if Handle.TransactSafe <> Value then
  begin
    if Connected then
    begin
      if Handle.TransactSafe then
        Handle.EndTransaction
      else
        Handle.StartTransaction;
    end;
    Handle.TransactSafe := Value;
  end;
end;

{ Process notification method }
procedure TZZTransact.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FDatabase ) and (Operation = opRemove) then
  begin
    Disconnect;
    FDatabase := nil;
    FHandle.Connect := nil;
    FQuery.Connect := nil;
  end;
end;

{ Connect to Sql-database }
procedure TZZTransact.Connect;
{$IFNDEF NO_GUI}
var
  OldCursor: TCursor;
{$ENDIF}
begin
  if FConnected then Exit;
{$IFNDEF NO_GUI}
  OldCursor := Screen.Cursor;
{$ENDIF}
  try
{$IFNDEF NO_GUI}
    if toHourGlass in FOptions then
      Screen.Cursor := crSqlWait;
{$ENDIF}

    if not Assigned(FDatabase) then
      DatabaseError(SConnectNotDefined);

    if Assigned(OnBeforeConnect) then
      OnBeforeConnect(Self);
    FDatabase.Connect;
    if not FDatabase.Connected then
      DatabaseError(SConnectError);

    if not FHandle.Active then
    begin
      FHandle.Open;
      if FHandle.Status <> csOk then
        DatabaseError(Convert(FHandle.Error, FDatabase.Encoding, etNone));
    end;
    FConnected := FHandle.Active;
    if Assigned(OnAfterConnect) then
      OnAfterConnect(Self);
  finally
{$IFNDEF NO_GUI}
    Screen.Cursor := OldCursor;
{$ENDIF}
  end;
end;

{ Disconnect from database }
procedure TZZTransact.Disconnect;
{$IFNDEF NO_GUI}
var
  OldCursor: TCursor;
{$ENDIF}
begin
  if not FConnected then Exit;
{$IFNDEF NO_GUI}
  OldCursor := Screen.Cursor;
{$ENDIF}
  try
{$IFNDEF NO_GUI}
    if toHourGlass in FOptions then
      Screen.Cursor := crSqlWait;
{$ENDIF}

    //CloseNotifies;
    if Assigned(OnBeforeDisconnect) then
      OnBeforeDisconnect(Self);
    FConnected := False;

    FHandle.Close;
    if FHandle.Status <> csOk then
      DatabaseError(Convert(FHandle.Error, FDatabase.Encoding, etNone));
  finally
{$IFNDEF NO_GUI}
    Screen.Cursor := OldCursor;
{$ENDIF}
  end;
  if Assigned(OnAfterDisconnect) then
    OnAfterDisconnect(Self);
end;

{ Call OnDataChange event }
procedure TZZTransact.DoDataChange(Sql: string);
var
  Token: string;
begin
  if Assigned(FOnDataChange) then
  begin
    Token := UpperCase(StrTok(Sql,' '#9#10#13));
    if (Token = 'UPDATE') or (Token = 'INSERT') or (Token = 'DELETE') then
      FOnDataChange(Self);
  end;
end;

{ Invoke OnApplyUpdates event }
procedure TZZTransact.DoApplyUpdates;
begin
  if Assigned(FOnApplyUpdates) then
    FOnApplyUpdates(Self);
end;

{ Invoke OnCommit event }
procedure TZZTransact.DoCommit;
begin
  if Assigned(FOnCommit) then
    FOnCommit(Self);
end;

{ Invoke OnRollback event }
procedure TZZTransact.DoRollback;
begin
  if Assigned(FOnRollback) then
    FOnRollback(Self);
end;

{ Execute a query }
function TZZTransact.ExecSql(Sql: WideString; comp : TComponent): LongInt;
var
{$IFNDEF NO_GUI}
  OldCursor: TCursor;
{$ENDIF}
  Error: string;
begin
  if not FConnected then
    DatabaseError(SNotConnected);
{$IFNDEF NO_GUI}
  OldCursor := Screen.Cursor;
{$ENDIF}
  try
{$IFNDEF NO_GUI}
    if toHourGlass in FOptions then
      Screen.Cursor := crSqlWait;
{$ENDIF}

    FQuery.Sql := Sql;
    Result := FQuery.Execute;
    if FQuery.Status <> qsCommandOk then
    begin
      Error := Convert(FQuery.Error, FDatabase.Encoding, etNone);
      Recovery(False);
      DatabaseError(Format('%s: %s', [comp.Name, Error]));
    end else
      DoDataChange(Sql);

    if FAutoCommit then Commit;
  finally
    FQuery.Sql := '';
{$IFNDEF NO_GUI}
    Screen.Cursor := OldCursor;
{$ENDIF}
  end;
end;

{ Execute an sql statement with parameters }
function TZZTransact.ExecSqlParams(Sql: WideString; Params: TVarRecArray;
  ParamCount: Integer): LongInt;
var
{$IFNDEF NO_GUI}
  OldCursor: TCursor;
{$ENDIF}
  Error: string;
begin
  if not FConnected then
    DatabaseError(SNotConnected);
{$IFNDEF NO_GUI}
  OldCursor := Screen.Cursor;
{$ENDIF}
  try
{$IFNDEF NO_GUI}
    if toHourGlass in FOptions then
      Screen.Cursor := crSqlWait;
{$ENDIF}

    FQuery.Sql := Sql;
    Result := FQuery.ExecuteParams(Params, ParamCount);
    if FQuery.Status <> qsCommandOk then
    begin
      Error := Convert(FQuery.Error, FDatabase.Encoding, etNone);
      Recovery(False);
      DatabaseError(Error);
    end else
      DoDataChange(Sql);

    if FAutoCommit then Commit;
  finally
{$IFNDEF NO_GUI}
    Screen.Cursor := OldCursor;
{$ENDIF}
  end;
end;

{ Execute a function with params and return a result }
function TZZTransact.ExecFunc(Func: WideString): WideString;
var
{$IFNDEF NO_GUI}
  OldCursor: TCursor;
{$ENDIF}
  Error: string;
begin
  if not FConnected then
    DatabaseError(SNotConnected);
{$IFNDEF NO_GUI}
  OldCursor := Screen.Cursor;
{$ENDIF}
  try
{$IFNDEF NO_GUI}
    if toHourGlass in FOptions then
      Screen.Cursor := crSqlWait;
{$ENDIF}

    FQuery.Sql := 'SELECT '+Func;
    FQuery.Open;
    if FQuery.Status <> qsTuplesOk then
    begin
      Error := Convert(FQuery.Error, FDatabase.Encoding, etNone);
      Recovery(False);
      DatabaseError(Error);
    end;

    Result := FQuery.Field(0);
    FQuery.Close;
    if FAutoCommit then Commit;
  finally
{$IFNDEF NO_GUI}
    Screen.Cursor := OldCursor;
{$ENDIF}
  end;
end;

{ Commit transaction }
procedure TZZTransact.Commit;
{$IFNDEF NO_GUI}
var
  OldCursor: TCursor;
{$ENDIF}
begin
  if not FConnected then
    DatabaseError(SNotConnected);
{$IFNDEF NO_GUI}
  OldCursor := Screen.Cursor;
{$ENDIF}
  try
{$IFNDEF NO_GUI}
    if toHourGlass in FOptions then
      Screen.Cursor := crSqlWait;
{$ENDIF}

    FHandle.Commit;
    if FHandle.Status <> csOk then
      DatabaseError(Convert(FHandle.Error, FDatabase.Encoding, etNone));
    DoCommit;
  finally
{$IFNDEF NO_GUI}
    Screen.Cursor := OldCursor;
{$ENDIF}
  end;
end;

{ Rollback transaction }
procedure TZZTransact.Rollback;
{$IFNDEF NO_GUI}
var
  OldCursor: TCursor;
{$ENDIF}
begin
  if not FConnected then
    DatabaseError(SNotConnected);
{$IFNDEF NO_GUI}
  OldCursor := Screen.Cursor;
{$ENDIF}
  try
{$IFNDEF NO_GUI}
    if toHourGlass in FOptions then
      Screen.Cursor := crSqlWait;
{$ENDIF}

    FHandle.Rollback;
    if FHandle.Status <> csOk then
      DatabaseError(Convert(FHandle.Error, FDatabase.Encoding, etNone));
    DoRollback;
  finally
{$IFNDEF NO_GUI}
    Screen.Cursor := OldCursor;
{$ENDIF}
  end;
end;

{ Execute a multiple queries }
function TZZTransact.BatchExecSql(Sql: WideString): LongInt;
var
  Text: string;
  Scanner: TZZSqlScanner;
  Stop: Boolean;
begin
  Scanner := ZSqlScanner.CreateSqlScanner(DatabaseType);
  Scanner.ShowEOL := True;
  FBatchCurPos := 0;
  FBatchCurLen := 0;
  FBatchCurrentLine := 1;
  Result := 0;
  try
    Scanner.Buffer := Sql;
    while True do
    begin
      Text := Scanner.ExtractStatement(FBatchCurPos, FBatchCurLen, FBatchCurrentLine);
      if Text='' then
        Break;
      try
        if Assigned(FOnBeforeBatchExec) then
          FOnBeforeBatchExec(Self, Text);
        Result := ExecSql(Text, self);
        if Assigned(FOnAfterBatchExec) then
          FOnAfterBatchExec(Self, Result);
      except
        on E: EDatabaseError do
        begin
          if Assigned(FOnBatchError) then
          begin
            Stop := True;
            FOnBatchError(Self, E, Stop);
            if Stop then
              raise;
          end
          else
            raise;
        end;
      end;
    end;
  finally
    Scanner.Free;
    if Assigned(FOnAfterBatchExec) then
      FOnAfterBatchExec(Self, Result);
  end;
end;

{ Recovery after error }
procedure TZZTransact.Recovery(Force: Boolean);
begin
end;

{ Open autoactivated datasets }
procedure TZZTransact.Loaded;
begin
  inherited Loaded;
  if Assigned(Database) then
    Database.OpenActiveDatasets;
end;

{ Get notify listener by index }
function TZZTransact.GetNotifies(Index: Integer): TObject;
begin
  Result := FNotifies[Index];
end;

{ Get notifies count }
function TZZTransact.GetNotifyCount: Integer;
begin
  Result := FNotifies.Count;
end;

{ Add new notify listener }
procedure TZZTransact.AddNotify(Notify: TObject);
begin
  if FNotifies.IndexOf(Notify) >= 0 then Exit;
  FNotifies.Add(Notify);
end;

{ Delete notify listener from list }
procedure TZZTransact.RemoveNotify(Notify: TObject);
var
  N: Integer;
begin
  N := FNotifies.IndexOf(Notify);
  if N >= 0 then
  try
    TZZNotify(FNotifies[N]).Close;
  finally
    FNotifies.Delete(N);
  end;
end;

{ Close all notify listeners }
procedure TZZTransact.CloseNotifies;
var
  I: Integer;
begin
  for I := 0 to FNotifies.Count-1 do
    try
      TZZNotify(FNotifies[I]).Close;
    except
    end;
end;

{*********** TZZMonitorList implementation ************}

{ Get monitor }
function TZZMonitorList.GetMonitor(Index: Integer): TZZMonitor;
begin
  Result := TZZMonitor(Items[Index]);
end;

{ Add new monitor }
procedure TZZMonitorList.AddMonitor(Value: TZZMonitor);
begin
  Add(Pointer(Value));
end;

{ Delete existed monitor }
procedure TZZMonitorList.DeleteMonitor(Value: TZZMonitor);
var
  N: Integer;
begin
  N := IndexOf(Pointer(Value));
  if N >= 0 then
    Delete(N);
end;

{ Invoke SqlEvent in all connected monitors }
procedure TZZMonitorList.InvokeEvent(Sql, Result: WideString; Error: Boolean);
var
  I: Integer;
begin
  for I := 0 to Count-1 do
    try
      if not Error then
        Result := 'OK.';
      if Assigned(Monitors[I].OnMonitorEvent) then
        Monitors[I].OnMonitorEvent(Sql, Result);
    except
    end;
end;

{*************** TZZBatchSql implementation **************}

{ Class constructor }
constructor TZZBatchSql.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSql := TStringList.Create;
end;

{ Class destructor }
destructor  TZZBatchSql.Destroy;
begin
  FSql.Free;
  inherited Destroy;
end;

{ Set new sql value }
procedure TZZBatchSql.SetSql(Value: TStringList);
begin
  FSql.Assign(Value);
end;

{ Process notification messages }
procedure TZZBatchSql.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FTransact ) and (Operation = opRemove) then
    FTransact   := nil;
end;

{ Execute sql statements }
procedure TZZBatchSql.ExecSql;
begin
  if Assigned(FTransact) then
  begin
    if Assigned(FBeforeExecute) then
      FBeforeExecute(Self);
    FTransact.Connected := True;
    FAffectedRows := FTransact.BatchExecSql(FSql.Text);
    if Assigned(FAfterExecute) then
      FAfterExecute(Self);
  end else
    DatabaseError(STransactNotDefined);
end;

{******************** TZZMonitor implementation ****************}

{ Class destructor }
destructor TZZMonitor.Destroy;
begin
  if Assigned(FTransact) and not (csDestroying in ComponentState) then
    FTransact.DeleteMonitor(Self);
  inherited Destroy;
end;

{ Process notification events }
procedure TZZMonitor.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FTransact) and (Operation = opRemove) then
  begin
    if Assigned(FTransact) then
      FTransact.DeleteMonitor(Self);
    FTransact := nil;
  end;
end;

{ Set new transaction }
procedure TZZMonitor.SetTransact(const Value: TZZTransact);
begin
  if FTransact <> Value then
  begin
    if Assigned(FTransact) then
      FTransact.DeleteMonitor(Self);
    FTransact := Value;
    if Assigned(FTransact) then
      FTransact.AddMonitor(Self);
  end;
end;

{******************** TZZNotify implementation ****************}

{ TZZNotify class constructor }
constructor TZZNotify.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FEventsList := TStringList.Create;
  with FEventsList do
  begin
    Duplicates := dupIgnore;
    OnChange := EventsChange;
    OnChanging := EventsChanging;
  end;
  FBackEventsList := TStringList.Create;

  FTimer := TTimer.Create(Self);
  FTimer.Enabled := False;
  FTimer.Interval := 250;
  FTimer.OnTimer := TimerProc;

  FActive := False;
  FFirstConnect := True;
end;

{ TZZNotify destructor }
destructor TZZNotify.Destroy;
begin
  Close;
  FEventsList.Free;
  FBackEventsList.Free;
  FTimer.Free;
  FHandle.Free;
  inherited Destroy;
end;

{ Set check interval }
procedure TZZNotify.SetInterval(Value: Cardinal);
begin
  FTimer.Interval := Value;
end;

{ Retrieve check interval }
function TZZNotify.GetInterval;
begin
  Result := FTimer.Interval;
end;

{ Update the events list and sends register events at the server }
procedure TZZNotify.SetEventsList(Value: TStringList);
var
  I: Integer;
begin
  FEventsList.Assign(Value);
  for I := 0 to FEventsList.Count -1 do
    FEventsList[I] := Trim(FEventsList[I]);
end;

{ Activate component }
procedure TZZNotify.SetActive(Value: Boolean);
begin
  if FActive <> Value then
  begin
    if Value then Open
    else Close;
  end;
end;

{ Set new transaction object }
procedure TZZNotify.SetTransact(Value: TZZTransact);
begin
  if FTransact <> Value then
  begin
    Close;
    if FTransact <> nil then
      FTransact.RemoveNotify(Self);
    FTransact := Value;
    if FTransact <> nil then
      FTransact.AddNotify(Self);
  end;
end;

{ Process notification messages }
procedure TZZNotify.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FTransact ) and (Operation = opRemove) then
    SetTransact(nil);
end;

{ Process events list changing }
procedure TZZNotify.EventsChanging(Sender: TObject);
begin
  if not Active then Exit;
  FBackEventsList.Text:=FEventsList.Text;
end;

{ Process events list changing }
procedure TZZNotify.EventsChange(Sender: TObject);
var
  I: Integer;
begin
  if not Active then Exit;
  with TStringList(FEventsList) do
  begin
    OnChange := nil;
    OnChanging := nil;
  end;

  try
    { Unregistering old events }
    for I := 0 to FBackEventsList.Count-1 do
    begin
      if FEventsList.IndexOf(FBackEventsList[I]) = -1 then
      begin
        FHandle.UnListenTo(Trim(FBackEventsList[I]));
        if FHandle.Status <> nsOK then
          DatabaseError(SNotifyRegister);
      end;
    end;

    { Registering new events }
    for I := 0 to FEventsList.Count-1 do
    begin
      if FBackEventsList.IndexOf(FEventsList[I])=-1 then
      begin
        FHandle.ListenTo(Trim(FEventsList[I]));
        if FHandle.Status <> nsOK then
          DatabaseError(SNotifyRegister);
      end;
    end;
  { Restoring change event handlers }
  finally
    with TStringList(FEventsList) do
    begin
      OnChange := EventsChange;
      OnChanging := EventsChanging;
    end;
    FBackEventsList.Clear;
  end;
end;

{ Internal procedure that will be called at each timer trigger }
procedure TZZNotify.TimerProc(Sender: TObject);
begin
  if not Active then
    FTimer.Enabled := False
  else CheckEvents;
end;

{ Raise exception if notify isn't active }
procedure TZZNotify.CheckActive;
begin
  if not Assigned(FTransact) then
    DatabaseError(STransactNotDefined);
  if not Active then
    DatabaseError('TZZNotify not in active mode');
  if not FTransact.Connected then
     DatabaseError(SNotConnected);
end;

{ Check autoopen property }
procedure TZZNotify.Loaded;
begin
  inherited Loaded;
  if FAutoOpen then
  begin
    FAutoOpen := False;
    Open;
  end;
end;

{ Start the events listener }
procedure TZZNotify.Open;
var
  I: Integer;
begin
  if Active then Exit;

  if not Assigned(FTransact) and (csLoading in ComponentState) then
  begin
    FAutoOpen := True;
    Exit;
  end;

  if not Assigned(FTransact) then
    DatabaseError(STransactNotDefined);
  if not FTransact.Connected then
    FTransact.Connect;

  FHandle.Connect := FTransact.Handle.Connect;
  FHandle.Transact := FTransact.Handle;

  { Registering events }
  for I := 0 to FEventsList.Count-1 do
  begin
    FHandle.ListenTo(FEventsList[I]);
    if FHandle.Status <> nsOk then
      DatabaseError(FHandle.Error);
  end;

  FActive := True;
  FTimer.Enabled := True;
end;

{ Stop the events listener }
procedure TZZNotify.Close;
var
  I: Integer;
begin
  if not Active then Exit;

  FTimer.Enabled := False;

  { Unregistering events }
  for I:= 0 to FEventsList.Count-1 do
  begin
    FHandle.UnlistenTo(FEventsList[I]);
    if FHandle.Status <> nsOk then
      DatabaseError(FHandle.Error);
  end;
  FTransact.Disconnect;
  FActive := False;
end;

{ Listen to a specific event }
procedure TZZNotify.ListenTo(Event: string);
begin
  if Assigned(FBeforeRegister) then
    FBeforeRegister(Self, Event);

  CheckActive;
  FHandle.ListenTo(Trim(Event));
  if FHandle.Status <> nsOk then
    DatabaseError(FHandle.Error);

  { Adding event to list }
  with FEventsList do
  begin
    OnChange := nil;
    OnChanging := nil;
    if IndexOf(Event) = -1 then
      Append(Event);
    OnChange := EventsChange;
    OnChanging := EventsChanging;
  end;

  if Assigned(FAfterRegister) then
    FAfterRegister(Self, Event);
end;

{ Generate a notify event }
procedure TZZNotify.DoNotify(Event: string);
begin
  CheckActive;
  FHandle.DoNotify(Event);
  if FHandle.Status <> nsOk then
    DatabaseError(FHandle.Error);
end;

{ Stop listening to a specific event }
procedure TZZNotify.UnlistenTo(Event: string);
begin
  if Assigned(FBeforeRegister) then
    FBeforeUnregister(Self, Event);

  CheckActive;
  FHandle.UnlistenTo(Trim(Event));
  if FHandle.Status <> nsOk then
    DatabaseError(FHandle.Error);

  { Removing event from list }
  with FEventsList do
  begin
    OnChange := nil;
    OnChanging := nil;
    Delete(IndexOf(Event));
    OnChange := EventsChange;
    OnChanging := EventsChanging;
  end;

  if Assigned(FAfterRegister) then
    FAfterUnregister(Self, Event);
end;

{ Checks for any pending events }
procedure TZZNotify.CheckEvents;
var
  Notify: string;
begin                         
  CheckActive;
  while True do
  begin
    Notify := Trim(FHandle.CheckEvents);
    if FHandle.Status<>nsOK then
      Exit;
    if Notify = '' then Break;
    if FEventsList.IndexOf(Notify) >= 0 then
    begin
      if Assigned(FNotifyFired) then
        FNotifyFired(Self, Notify);
    end;
  end;
end;

{start tranzaction manually}
procedure TZZTransact.StartTransaction;
{$IFNDEF NO_GUI}
var
  OldCursor: TCursor;
{$ENDIF}
begin
  if not FConnected then
    DatabaseError(SNotConnected);
{$IFNDEF NO_GUI}
  OldCursor := Screen.Cursor;
{$ENDIF}
  try
{$IFNDEF NO_GUI}
    if toHourGlass in FOptions then
      Screen.Cursor := crSqlWait;
{$ENDIF}
    FHandle.StartTransaction;
    if FHandle.Status <> csOk then
      DatabaseError(Convert(FHandle.Error, FDatabase.Encoding, etNone));
  finally
{$IFNDEF NO_GUI}
    Screen.Cursor := OldCursor;
{$ENDIF}
  end;
end;

end.
